home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
SPACE 1
/
SPACE - Library 1 - Volume 1.iso
/
games
/
365
/
bingo
/
bingo.lst
next >
Wrap
File List
|
1989-10-14
|
29KB
|
1,364 lines
' ********************************
' * ST - BINGO *
' * ATARI ST- COMPUTERS *
' * A.BAGGETTA *
' * GFA BASIC V.2.0 *
' * 1988 *
' ********************************
Dim L$(5),N$(100),Sv$(1000),Comptr1%(5,5),Comptr2%(5,5),Ct%(25)
Dim B(5),I(5),N(5),G(5),O(5),Bb(5),Ii(5),Nn(5),Gg(5),Oo(5),C(5)
Dim Oldcolri(15),Oldcolrr(15),Oldcolrg(15),Oldcolrb(15)
Dim Msa(50),Msb(50),Msc(50),Msd(50),Mse(50),Pm(50),Pcm(50),Pcmr(50)
@Colr_get !Save the colors
Cls
If Exist("Winner.fil") Then !Check for Winner File
Print "Loading Winner file..." !If ok load the file. If not
Open "I",#1,"Winner.fil" !Start over again
Input #1,Win$
Close #1
Else
Alert 3," | |Missing Winner File",1,"END",Ab
Goto Finish
Endif
Cls
Start_prg:
Cls !Clear the screen and set the
Restore Clrz !Screen colors
For Clrz%=1 To 9
Read Cl1,Cl2,Cl3,Cl4
Setcolor Cl1,Cl2,Cl3,Cl4
Next Clrz%
Clrz:
Data 0,0,0,0,1,7,7,7,2,2,3,2,3,5,3,1,4,7,2,3,6,4,5,3,7,2,4,3,9,5,4,3,15,7,7,7
Rna=1000 !Select a random amount for prize
Rnb=5000 !Money
Cpz=Int(Rnd*(Rnb-Rna+1))+Rna
X%=0
Deffill 2,2,7 !Set up the menu screen
Pbox 8,10,296,199
Graphmode 4
Deftext 4,4,0,32
Text 38,44," ST-BINGO "
Graphmode 1
Deffill 3,2,8
Prbox 20,55,285,185
Defline 6,2,0,0
Prbox 20,55,285,185
Rbox 20,55,285,185
Graphmode 2
Deftext 5,5,0,9
Text 50,80,"Your Selection?"
Deftext 6,5,0,8
Text 100,100,"Play Bingo"
Text 100,120,"Make Cards"
Text 100,140,"Quit"
D$=Chr$(14)+Chr$(15)
Dup$=String$(9,D$)
Deftext 1,5,0,8
Text 50,160,Dup$
Color 6
Circle 85,98,5
Circle 85,118,5
Circle 85,138,5
Showm
Do !Mouse control for the Menu Screen
Mouse Mc,Mr,Mb
If (Mc>80 And Mc<90) And (Mr>95 And Mr<101) And Mb=1
Graphmode 1
Deffill 3,2,8
Prbox 20,55,285,185
@Play_bingo
Goto Start_prg
Endif
If (Mc>80 And Mc<90) And (Mr>115 And Mr<123) And Mb=1
Print At(10,5);"make cards"
Cls
Goto Make_cards
Goto Start_prg
Endif
If (Mc>80 And Mc<90) And (Mr>135 And Mr<141) And Mb=1
Cls
Goto Finish
Endif
Loop
'
Procedure Play_bingo
Leave=0 !LEAVE GAME FLAG
Cd=0 !CARD # FLAG
@Array_set !Clear the arrays
' Set up the main screen to play BINGO
Deffill 0,2,8
Graphmode 2
Text 85,100," "
Line 100,79,204,79
Line 100,113,204,113
For Grow=100 To 204 Step 2
Pbox 100,80,Grow,112
Next Grow
Deftext 1,4,0,6
Text 110,93,"Let's Play"
Text 125,103,"BINGO!"
Deffill 10,2,8
Prbox 102,125,204,135
Deffill 6,2,8
Prbox 50,150,120,165
Prbox 185,150,255,165
Deffill 11,2,8
Defline 1,3,0,0
Color 8
Rbox 20,55,285,185
Rbox 102,125,204,135
Rbox 50,150,120,165
Rbox 185,150,255,165
Deftext 3,16,0,5
Graphmode 2
Text 67,160,"CALL"
Text 197,160,"BINGO!"
Deftext 3,0,0,4
Text 110,132,"AUTO CALL - OFF"
Deftext 1,0,0,4
Defline 1,1,0,0
Color 0
'
Restore Small_crds !Draw the computer's cards
For Smx%=1 To 20
Read Sma,Smb,Smc,Smd
If Smx%=1 Or Smx%=11 Then
Rbox Sma,Smb,Smc,Smd
Else
Line Sma,Smb,Smc,Smd
Endif
Next Smx%
Graphmode 2
Deftext 1,1,0,4
Text 28,68,"B"
Text 44,68,"I"
Text 60,68,"N"
Text 74,68,"G"
Text 90,68,"O"
Deftext 1,0,0,4
Restore Comp_crd1
'
' Store the numbers on card 1 in an array comptr1%(xx,yy)
'
Freebe=0
Xx=0
Yy=0
For Rp%=1 To 25
Read C,R
N=Int(Rnd*75)+1
N$=Str$(N)
If Len(N$)=1
N$=" "+N$
Endif
If Rp%<>13 Then
Text C,R,N$
Else
Deftext 10,0,0,4
Text C,R,"FR"
Deftext 1,0,0,4
Endif
If Rp%>0 And Rp%<6 Then
Xx=1
Endif
If Rp%>5 And Rp%<11 Then
Xx=2
Endif
If Rp%>10 And Rp%<16 Then
Xx=3
Endif
If Rp%>15 And Rp%<21 Then
Xx=4
Endif
If Rp%>20 And Rp%<26 Then
Xx=5
Endif
If Yy=5 Then
Yy=0
Endif
Yy=Yy+1
If Rp%=13 Then
N=-1
Endif
Comptr1%(Xx,Yy)=N
Next Rp%
'
Deftext 1,1,0,4
Text 211,68,"B"
Text 227,68,"I"
Text 242,68,"N"
Text 257,68,"G"
Text 272,68,"O"
Deftext 1,0,0,4
'
Restore Comp_crd2
'
' Store the numbers on card 2 in an array comptr2%(xx,yy)
'
Freebe=0
Xx=0
Yy=0
For Rp%=1 To 25
Read C,R
N=Int(Rnd*75)+1
N$=Str$(N)
If Len(N$)=1
N$=" "+N$
Endif
If Rp%<>13 Then
Text C,R,N$
Else
Deftext 10,0,0,4
Text C,R,"FR"
Deftext 1,0,0,4
Endif
If Rp%>0 And Rp%<6 Then
Xx=1
Endif
If Rp%>5 And Rp%<11 Then
Xx=2
Endif
If Rp%>10 And Rp%<16 Then
Xx=3
Endif
If Rp%>15 And Rp%<21 Then
Xx=4
Endif
If Rp%>20 And Rp%<26 Then
Xx=5
Endif
If Yy=5 Then
Yy=0
Endif
Yy=Yy+1
If Rp%=13 Then
N=-1
Endif
Comptr2%(Xx,Yy)=N
Next Rp%
Deftext 11,0,0,4
Text 105,68,Chr$(4)+"COMPUTER CARDS"+Chr$(3)
Deftext 11,0,0,4
Text 40,135,"CARD #1"
Text 223,135,"CARD #2"
Graphmode 2
Box 145,153,160,162
Text 148,159,Chr$(14)+Chr$(15)
Deftext 1,1,0,4
Text 141,169,"QUIT"
Deftext 1,0,0,4
Graphmode 4
Text 45,172," Last Winner "
Text 183,172," Cash Prize "
Graphmode 2
Text 60,180,Win$
Text 195,180,"$"+Str$(Cpz)+".00"
Graphmode 1
Yup=0
T:
Do !Game Mouse Control
Showm
Mouse Mc,Mr,Mb
If (Mc>50 And Mc<120) And (Mr>150 And Mr<165) And Mb=1
Goto Jout
Endif
If (Mc>185 And Mc<255) And (Mr>150 And Mr<165) And Mb=1
Hidem
Sget Screen$
@Check_bingo
If Yup Then
Goto Sto
Endif
Endif
If (Mc>100 And Mc<200) And (Mr>125 And Mr<135) And Mb=1
Graphmode 2
Color 8
Deffill 10,2,8
Prbox 102,125,204,135
Defline 1,3,0,0
Rbox 102,125,204,135
Deftext 3,0,0,4
Text 110,132,"AUTO CALL - ON"
Graphmode 1
Deftext 1,0,0,12
Auto=1
Goto Jout
Endif
If (Mc>145 And Mc<160) And (Mr>153 And Mr<162) And Mb=1
Goto Sto
Endif
Loop
Jout:
Showm
Deftext 1,0,0,12
Deffill 3,2,8
For Grow=204 To 100 Step -2 !Clear the old Bingo number
Sound 1,15,Grow/8,4
Pbox Grow,80,204,112
Next Grow
Sound 1,0
Deffill 0,2,8
For Grow=100 To 204 Step 2
Sound 1,15,Grow/8,4
Pbox 100,80,Grow,112
Next Grow
Sound 1,0
Try_again:
Tg=0 !Select Bingo number
Lter=Int(Rnd*5)+1
N=Int(Rnd*75)+1
For Cut%=0 To X%
If Sv$(Cut%)=L$(Lter)+Str$(N) Then
Tg=1
Endif
Next Cut%
If Tg=1 Then
Goto Try_again
Endif
Ck$=L$(Lter)
@Chk_comp_crd(Ck$) !Run a check on the cards
If Leave=1 Then
Deftext 1,4,0,32
If Cd=1 Then
Get 23,57,100,128,Cd$ ! CUT CARD ONE FROM SCREEN
Cls
Text 70,30,"ST-BINGO"
Setcolor 0,4,0,0
Put 100,50,Cd$,3
Print At(15,19);"CARD #1"
Print At(12,21);"COMPUTER WINS"
Win$="COMPUTER"
Open "o",#1,"Winner.fil"
Write #1,Win$
Close #1
Pause 400
Goto Sto
Else
If Cd=2 Then
Get 205,57,282,128,Cd$
Cls
Text 70,30,"ST-BINGO"
Setcolor 0,4,0,0
Put 100,50,Cd$,3
Print At(15,19);"CARD #2"
Print At(12,21);"COMPUTER WINS"
Win$="COMPUTER"
Open "o",#1,"Winner.fil"
Write #1,Win$
Close #1
Pause 400
Goto Sto
Endif
Endif
Endif
Jmphere:
Text 108,100,L$(Lter)+" "+Str$(N)
' Save the letter/number combination for later check
X%=X%+1
Sv$(X%)=L$(Lter)+Str$(N)
If Auto=1
For Del=1 To 75000
Showm
Next Del
Endif
Repeat
Mouse Mc,Mr,Mb
If Mb=2 Then
Inc Visit
If Visit=1
Print At(17,14);"PAUSE"
Endif
Endif
Until Mb<>2
If Mb<>2
Print At(17,14);" "
Visit=0
Endif
If (Mc>100 And Mc<200) And (Mr>125 And Mr<135) And Mb=1
Auto=0
Graphmode 2
Color 8
Deffill 10,2,8
Prbox 102,125,200,135
Defline 1,3,0,0
Rbox 102,125,200,135
Deftext 3,0,0,4
Text 110,132,"AUTO CALL - OFF"
Graphmode 1
Deftext 1,0,0,12
Pause 50
Endif
If Auto=0 Then
Goto T
Else
Goto Jout
Endif
Sto:
Return
'
Make_cards:
Count=0
Setcolor 0,7,7,7 ! Set new screen colors
Setcolor 1,5,2,3
Setcolor 15,0,0,0
Deftext 1,0,0,15
Text 70,50,"Bingo Card Designer" ! Set up Alert String
Alert$="Before Printing Bingo Card |be sure your printer is set |to 960 dots per line. "
Alert 0,Alert$,0,"Randomly|Personal|Quit",Choose
If Choose=1 Then ! Alert Box choices
Goto Make_one
Endif
If Choose=2 Then
Goto Make_two
Endif
If Choose=3 Then
Goto Start_prg
Endif
Make_one: ! Design the first type of card
Cls
Tcrd:
Cls
Color 1
Defline 0,3,0,0
Rbox 30,10,250,185
Defline 0,2,0,0
Line 74,10,74,185
Line 118,10,118,185
Line 162,10,162,185
Line 206,10,206,185
Defline 0,3,0,0
Line 30,39,250,39
Defline 0,2,0,0
Line 30,68,250,68
Line 30,97,250,97
Line 30,126,250,126
Line 30,155,250,155
' fill in the labels on the large card
Deftext 2,4,0,20
Restore Big_crds_lbls
For Bigx%=1 To 30
Read Biga,Bigb,Bigc$
If Bigx%=6 Then
Deftext 1,0,0,4
Endif
Text Biga,Bigb,Bigc$
Next Bigx%
Deftext 2,0,0,10
Restore Cdata
Freebe=0
For Rp=1 To 25 ! Put numbers on the card
Read C,R
N=Int(Rnd*75)+1
N$=Str$(N)
If Len(N$)=1
N$=" "+N$
Endif
If Freebe<2 Then
Free=Int(Rnd*15)+1
If Free=9
Inc Freebe
Deftext 2,0,0,7
Text C-7,R,"FREE"
Deftext 2,0,0,10
Goto Jmp
Endif
Endif
If Rp<>13 Then
Text C,R,N$
Else
Deftext 2,0,0,7
Text C-7,R,"FREE"
Deftext 2,0,0,10
Endif
Jmp:
Next Rp
Deftext 1,0,0,4 ! Check to see if card is OK
Text 260,50,"Card OK?"
Box 260,70,270,80
Box 290,70,300,80
Box 260,85,300,95
Text 263,77,"Y"
Text 293,77,"N"
Text 268,92,"QUIT"
Inc Count
Text 263,110,"CARD #"+Str$(Count)
Do
Mouse Mc,Mr,Mb
If (Mc>260 And Mc<270) And (Mr>70 And Mr<80) And Mb=1
Hidem
Deffill 0,2,8
Pbox 260,40,370,120
Hardcopy
Showm
For Mulcop=1 To 35
Lprint
Next Mulcop
Goto Tcrd
Endif
If (Mc>290 And Mc<300) And (Mr>70 And Mr<80) And Mb=1
Dec Count
Goto Tcrd
Endif
If (Mc>260 And Mc<300) And (Mr>85 And Mr<95) And Mb=1
Goto Bak_menu
Endif
Loop
Bak_menu:
Goto Start_prg
Make_two: ! Make the second kind of card
'
'
Graphmode 1
Setcolor 0,7,7,7
Setcolor 1,5,2,3
Setcolor 15,0,0,0
Deftext 1,0,0,15
Cls
Color 1
Defline 0,3,0,0
Rbox 30,10,250,185
Defline 0,2,0,0
Line 74,10,74,185
Line 118,10,118,185
Line 162,10,162,185
Line 206,10,206,185
Defline 0,3,0,0
Line 30,39,250,39
Defline 0,2,0,0
Line 30,68,250,68
Line 30,97,250,97
Line 30,126,250,126
Line 30,155,250,155
' fill in the labels on the large card
Deftext 2,4,0,20
Restore Big_crds_lbls
For Bigx%=1 To 30
Read Biga,Bigb,Bigc$
If Bigx%=6 Then
Deftext 1,0,0,4
Endif
Text Biga,Bigb,Bigc$
Next Bigx%
Deftext 2,0,0,4
Defline 1,1,0,0
Box 260,85,300,95
Box 260,105,300,115
Text 268,92,"DONE"
Text 268,112,"QUIT"
Deftext 2,0,0,10
Restore Mous_crd_dat
For Msrch%=1 To 50
Read A,B,C,D,E,F,G,H
Msa(Msrch%)=A
Msb(Msrch%)=B
Msc(Msrch%)=C
Msd(Msrch%)=D
Mse(Msrch%)=E
Pm(Msrch%)=F
Pcm(Msrch%)=G
Pcmr(Msrch%)=H
Next Msrch%
'
Do
Mouse A,B,C
For Msrch%=1 To 50
If (A>Msa(Msrch%) And A<Msb(Msrch%)) And (B>Msc(Msrch%) And B<Msd(Msrch%)) And C=1 Then
P=Pm(Msrch%)
Pc=Pcm(Msrch%)
Pr=Pcmr(Msrch%)
@Make_ver_crdup
C=0
Endif
If (A>Msa(Msrch%) And A<Msb(Msrch%)) And (B>Msc(Msrch%) And B<Msd(Msrch%)) And C=2 Then
P=Pm(Msrch%)
Pc=Pcm(Msrch%)
Pr=Pcmr(Msrch%)
@Make_ver_crdown
C=0
Endif
Next Msrch%
If (A>260 And A<300) And (B>85 And B<95) And C=1
Hidem
Deffill 0,2,8
Pbox 260,85,300,140
Hardcopy
Showm
Goto Jloop
Endif
If (A>260 And A<300) And (B>105 And B<115) And C=1
Goto Jloop
Endif
Loop
Jloop:
Goto Start_prg
'
' SET ARRAYS
'
Procedure Array_set
L$(1)="B"
L$(2)="I"
L$(3)="N"
L$(4)="G"
L$(5)="O"
Arrayfill B(),0
Arrayfill I(),0
Arrayfill N(),0
Arrayfill G(),0
Arrayfill O(),0
Arrayfill Bb(),0
Arrayfill Ii(),0
Arrayfill Nn(),0
Arrayfill Gg(),0
Arrayfill Oo(),0
Arrayfill C(),0
Cd=0
Return
'
Procedure Chk_comp_crd(Ck$)
Deffill 10,2,8
If Ck$="B" Then
If Comptr1%(1,1)=N Then
Fill 25,79
B(1)=1
@Snd
Endif
If Comptr1%(1,2)=N Then
Fill 25,90
B(2)=1
@Snd
Endif
If Comptr1%(1,3)=N Then
Fill 25,101
B(3)=1
@Snd
Endif
If Comptr1%(1,4)=N Then
Fill 25,112
B(4)=1
@Snd
Endif
If Comptr1%(1,5)=N Then
Fill 25,123
B(5)=1
@Snd
Endif
If Comptr2%(1,1)=N Then
Fill 208,79
Bb(1)=1
@Snd
Endif
If Comptr2%(1,2)=N Then
Fill 208,90
Bb(2)=1
@Snd
Endif
If Comptr2%(1,3)=N Then
Fill 208,101
Bb(3)=1
@Snd
Endif
If Comptr2%(1,4)=N Then
Fill 208,112
Bb(4)=1
@Snd
Endif
If Comptr2%(1,5)=N Then
Fill 208,123
Bb(5)=1
@Snd
Endif
Endif
If Ck$="I" Then
If Comptr1%(2,1)=N Then
Fill 41,79
I(1)=1
@Snd
Endif
If Comptr1%(2,2)=N Then
Fill 41,90
I(2)=1
@Snd
Endif
If Comptr1%(2,3)=N Then
Fill 41,101
I(3)=1
@Snd
Endif
If Comptr1%(2,4)=N Then
Fill 41,112
I(4)=1
@Snd
Endif
If Comptr1%(2,5)=N Then
Fill 41,123
I(5)=1
@Snd
Endif
If Comptr2%(2,1)=N Then
Fill 223,79
Ii(1)=1
@Snd
Endif
If Comptr2%(2,2)=N Then
Fill 223,90
Ii(2)=1
@Snd
Endif
If Comptr2%(2,3)=N Then
Fill 223,101
Ii(3)=1
@Snd
Endif
If Comptr2%(2,4)=N Then
Fill 223,112
Ii(4)=1
@Snd
Endif
If Comptr2%(2,5)=N Then
Fill 223,123
Ii(5)=1
@Snd
Endif
Endif
If Ck$="N" Then
If Comptr1%(3,1)=N Then
Fill 56,79
N(1)=1
@Snd
Endif
If Comptr1%(3,2)=N Then
Fill 56,90
N(2)=1
@Snd
Endif
If Comptr1%(3,3)=N Then
Fill 56,101
N(3)=1
@Snd
Endif
If Comptr1%(3,4)=N Then
Fill 56,112
N(4)=1
@Snd
Endif
If Comptr1%(3,5)=N Then
Fill 56,123
N(5)=1
@Snd
Endif
If Comptr2%(3,1)=N Then
Fill 238,79
Nn(1)=1
@Snd
Endif
If Comptr2%(3,2)=N Then
Fill 238,90
Nn(2)=1
@Snd
Endif
If Comptr2%(3,3)=N Then
Fill 238,101
Nn(3)=1
@Snd
Endif
If Comptr2%(3,4)=N Then
Fill 238,112
Nn(4)=1
@Snd
Endif
If Comptr2%(3,5)=N Then
Fill 238,123
Nn(5)=1
@Snd
Endif
Endif
If Ck$="G" Then
If Comptr1%(4,1)=N Then
Fill 71,79
G(1)=1
@Snd
Endif
If Comptr1%(4,2)=N Then
Fill 71,90
G(2)=1
@Snd
Endif
If Comptr1%(4,3)=N Then
Fill 71,101
G(3)=1
@Snd
Endif
If Comptr1%(4,4)=N Then
Fill 71,112
G(4)=1
@Snd
Endif
If Comptr1%(4,5)=N Then
Fill 71,123
G(5)=1
@Snd
Endif
If Comptr2%(4,1)=N Then
Fill 253,79
Gg(1)=1
@Snd
Endif
If Comptr2%(4,2)=N Then
Fill 253,90
Gg(2)=1
@Snd
Endif
If Comptr2%(4,3)=N Then
Fill 253,101
Gg(3)=1
@Snd
Endif
If Comptr2%(4,4)=N Then
Fill 253,112
Gg(4)=1
@Snd
Endif
If Comptr2%(4,5)=N Then
Fill 253,123
Gg(5)=1
@Snd
Endif
Endif
If Ck$="O" Then
If Comptr1%(5,1)=N Then
Fill 86,79
O(1)=1
@Snd
Endif
If Comptr1%(5,2)=N Then
Fill 86,90
O(2)=1
@Snd
Endif
If Comptr1%(5,3)=N Then
Fill 86,101
O(3)=1
@Snd
Endif
If Comptr1%(5,4)=N Then
Fill 86,112
O(4)=1
@Snd
Endif
If Comptr1%(5,5)=N Then
Fill 86,123
O(5)=1
@Snd
Endif
If Comptr2%(5,1)=N Then
Fill 268,79
Oo(1)=1
@Snd
Endif
If Comptr2%(5,2)=N Then
Fill 268,90
Oo(2)=1
@Snd
Endif
If Comptr2%(5,3)=N Then
Fill 268,101
Oo(3)=1
@Snd
Endif
If Comptr2%(5,4)=N Then
Fill 268,112
Oo(4)=1
@Snd
Endif
If Comptr2%(5,5)=N Then
Fill 268,123
Oo(5)=1
@Snd
Endif
Endif
@Full_five
Return
'
Procedure Full_five
' Vertical Columns Card #1
'
If B(1) And B(2) And B(3) And B(4) And B(5) Then
Cd=1
@Comp_got_bingo
Endif
If I(1) And I(2) And I(3) And I(4) And I(5) Then
Cd=1
@Comp_got_bingo
Endif
If N(1) And N(2) And N(4) And N(5) Then !Includes FREE
Cd=1
@Comp_got_bingo
Endif
If G(1) And G(2) And G(3) And G(4) And G(5) Then
Cd=1
@Comp_got_bingo
Endif
If O(1) And O(2) And O(3) And O(4) And O(5) Then
Cd=1
@Comp_got_bingo
Endif
' Horizontal Columns Card #1
'
If B(1) And I(1) And N(1) And G(1) And O(1) Then
Cd=1
@Comp_got_bingo
Endif
If B(2) And I(2) And N(2) And G(2) And O(2) Then
Cd=1
@Comp_got_bingo
Endif
If B(3) And I(3) And G(3) And O(3) Then !Includes FREE
Cd=1
@Comp_got_bingo
Endif
If B(4) And I(4) And N(4) And G(4) And O(4) Then
Cd=1
@Comp_got_bingo
Endif
If B(5) And I(5) And N(5) And G(5) And O(5) Then
Cd=1
@Comp_got_bingo
Endif
' Diagonal Column on B1 -- Card #1
'
If B(1) And I(2) And G(4) And O(5) Then
Cd=1
@Comp_got_bingo
Endif
' Diagonal Column on O1 -- Card #1
'
If O(1) And G(2) And I(4) And B(5) Then
Cd=1
@Comp_got_bingo
Endif
' Vertical Columns Card #2
'
If Bb(1) And Bb(2) And Bb(3) And Bb(4) And Bb(5) Then
Cd=2
@Comp_got_bingo
Endif
If Ii(1) And Ii(2) And Ii(3) And Ii(4) And Ii(5) Then
Cd=2
@Comp_got_bingo
Endif
If Nn(1) And Nn(2) And Nn(4) And Nn(5) Then !Includes FREE
Cd=2
@Comp_got_bingo
Endif
If Gg(1) And Gg(2) And Gg(3) And Gg(4) And Gg(5) Then
Cd=2
@Comp_got_bingo
Endif
If Oo(1) And Oo(2) And Oo(3) And Oo(4) And Oo(5) Then
Cd=2
@Comp_got_bingo
Endif
' Horizontal Columns Card #2
'
If Bb(1) And Ii(1) And Nn(1) And Gg(1) And Oo(1) Then
Cd=2
@Comp_got_bingo
Endif
If Bb(2) And Ii(2) And Nn(2) And Gg(2) And Oo(2) Then
Cd=2
@Comp_got_bingo
Endif
If Bb(3) And Ii(3) And Gg(3) And Oo(3) Then !Includes FREE
Cd=2
@Comp_got_bingo
Endif
If Bb(4) And Ii(4) And Nn(4) And Gg(4) And Oo(4) Then
Cd=2
@Comp_got_bingo
Endif
If Bb(5) And Ii(5) And Nn(5) And Gg(5) And Oo(5) Then
Cd=2
@Comp_got_bingo
Endif
' Diagonal Column on B1 -- Card #2
'
If Bb(1) And Ii(2) And Gg(4) And Oo(5) Then
Cd=2
@Comp_got_bingo
Endif
' Diagonal Column on O1 -- Card #2
'
If Oo(1) And Gg(2) And Ii(4) And Bb(5) Then
Cd=2
@Comp_got_bingo
Endif
Return
'
Procedure Snd
Sound 1,15,1,5,1
Sound 1,0
Sound 1,15,7,7,1
Sound 1,0
Return
'
Procedure Comp_got_bingo
Deftext 1,4,0,6
Deffill 0,2,8
For Zr=1 To 10
Sound 1,15,1,5,1
Prbox 100,80,204,112
Text 120,100,"!BINGO!"
Pause 1
Sound 1,15,7,7,1
Next Zr
Sound 1,0
Leave=1
Return
'
Procedure Check_bingo
Cls
Graphmode 4
Deftext 4,0,0,6
Text 5,7," VERIFICATION SCREEN "
Graphmode 1
Print At(2,3);"Name please: ";
Form Input 8,Nm$
Print At(2,5);"Enter your winning combination"
Print At(2,6);"one part at a time. Press RETURN"
Print At(2,7);"after each entry."
Ck_1:
Au=0
Print At(2,9);" "
Print At(2,9);
Print "First entry: ";
Form Input 3,Fir$
If Fir$<>"FRE" Then
Sw$=Fir$
@Check_ending
If Au Then
Goto Ck_1
Endif
Endif
Ck_2:
Au=0
Print At(2,11);" "
Print At(2,11);
Print "Second entry: ";
Form Input 3,Sec$
If Sec$<>"FRE" Then
Sw$=Sec$
@Check_ending
If Au Then
Goto Ck_2
Endif
Endif
Ck_3:
Au=0
Print At(2,13);" "
Print At(2,13);
Print "Third entry: ";
Form Input 3,Thir$
If Thir$<>"FRE" Then
Sw$=Thir$
@Check_ending
If Au Then
Goto Ck_3
Endif
Endif
Ck_4:
Au=0
Print At(2,15);" "
Print At(2,15);
Print "Fourth entry: ";
Form Input 3,Fou$
If Fou$<>"FRE" Then
Sw$=Fou$
@Check_ending
If Au Then
Goto Ck_4
Endif
Endif
Ck_5:
Au=0
Print At(2,17);" "
Print At(2,17);
Print "Fifth entry: ";
Form Input 3,Fif$
If Fif$<>"FRE" Then
Sw$=Fif$
@Check_ending
If Au Then
Goto Ck_5
Endif
Endif
Print
Print At(2,19);"Satisfied? Y/N ";
Form Input 1,Sati$
If Sati$="N" Or Sati$="n" Then
@Check_bingo
Endif
For J%=1 To X%
If Fir$="FRE" Or Sv$(J%)=Fir$
C(1)=1
Endif
If Sec$="FRE" Or Sv$(J%)=Sec$
C(2)=1
Endif
If Thir$="FRE" Or Sv$(J%)=Thir$
C(3)=1
Endif
If Fou$="FRE" Or Sv$(J%)=Fou$
C(4)=1
Endif
If Fif$="FRE" Or Sv$(J%)=Fif$
C(5)=1
Endif
Next J%
If C(1)=1 And C(2)=1 And C(3)=1 And C(4)=1 And C(5)=1
@Winner
Yup=1
For J%=1 To X%
Sv$(J%)=""
Next J%
Win$=Nm$
Open "o",#1,"Winner.fil"
Write #1,Win$
Close #1
Pause 300
Else
Print
Print " SORRY! CARD NO GOOD"
Pause 300
Cls
Sput Screen$
Endif
Return
'
Procedure Make_ver_crdup
Inc Ct%(P)
If Ct%(P)=76 Then
Text Pc,Pr,"FR"
Goto Pv
Endif
If Ct%(P)=77 Then
Ct%(P)=1
Text Pc,Pr," "
Endif
Text Pc,Pr,Str$(Ct%(P))
Pv:
Pause 5
Return
'
Procedure Make_ver_crdown
Dec Ct%(P)
If Ct%(P)=9 Then
Text Pc,Pr," "
Endif
If Ct%(P)=0 Then
Text Pc,Pr,"FR"
Goto Pvv
Endif
If Ct%(P)=-1 Then
Text Pc,Pr," "
Ct%(P)=75
Endif
Text Pc,Pr,Str$(Ct%(P))
Pvv:
Pause 5
Return
'
Procedure Check_ending
If Sw$="" Then
Print At(2,20);"You must enter something."
Pause 100
Print At(2,20);" "
Au=1
Goto Leave
Endif
If Mid$(Sw$,1,1)>"Z"
Print At(2,20);"LOCK UPPER CASE"
Pause 100
Print At(2,20);" "
Au=1
Endif
If Mid$(Sw$,1,1)<>"B" And Mid$(Sw$,1,1)<>"I" And Mid$(Sw$,1,1)<>"N" And Mid$(Sw$,1,1)<>"G" And Mid$(Sw$,1,1)<>"O" Then
Print At(2,20);"First character must be letter BINGO"
Pause 100
Print At(2,20);" "
Au=1
Endif
If (Mid$(Sw$,2,1)<"0" Or Mid$(Sw$,2,1)>"9") Then
Print At(2,20);"2nd character must be a number"
Pause 100
Print At(2,20);" "
Au=1
Endif
If Len(Sw$)>2 Then
If (Mid$(Sw$,3,1)<"0" Or Mid$(Sw$,3,1)>"9") Then
Print At(2,20);"3rd character must be a number"
Pause 100
Print At(2,20);" "
Au=1
Endif
Endif
Leave:
Return
'
Procedure Winner
Graphmode 1
Deffill 4,2,19
Cls
For Gc%=1 To 10
Pcircle 30,50,Gc%
Next Gc%
Deffill 2,2,19
For Gc%=1 To 20
Pcircle 250,60,Gc%
Next Gc%
Deffill 5,2,19
For Gc%=1 To 30
Pcircle 50,150,Gc%
Next Gc%
Deffill 10,2,19
For Gc%=1 To 25
Pcircle 260,170,Gc%
Next Gc%
For Dt%=1 To 100
Color Int(Rnd*15)+1
R=Int(Rnd*200)+1
C=Int(Rnd*300)+1
Plot C,R
Next Dt%
Deftext 2,0,0,32
Text 50,50,"BINGO"
Deftext 4,0,0,32
Text 100,100,"FOR"
Deftext 7,0,0,32
Text 100,150,Nm$
Deftext 8,0,0,16
Text 115,180,"$"+Str$(Cpz)+".00"
Return
'
' keep the old color pallett
'
Procedure Colr_get
For I%=0 To 15
@Vq_color(I%)
Oldcolri(I%)=I%
Oldcolrr(I%)=R%
Oldcolrg(I%)=G%
Oldcolrb(I%)=B%
Next I%
Return
'
Procedure Vq_color(I%)
Dpoke Contrl,26
Dpoke Contrl+2,0
Dpoke Contrl+4,0
Dpoke Contrl+6,2
Dpoke Contrl+8,0
Dpoke Intin,I%
Dpoke Intin+2,1
Vdisys
R%=Dpeek(Intout+2)
G%=Dpeek(Intout+4)
B%=Dpeek(Intout+6)
Return
'
' restore old colors and end
'
Finish:
For I%=0 To 15
In%=Oldcolri(I%)
R%=Oldcolrr(I%)
G%=Oldcolrg(I%)
B%=Oldcolrb(I%)
Gosub Vr_color(In%,R%,G%,B%)
Next I%
End
'
Procedure Vr_color(In%,R%,G%,B%)
Dpoke Contrl,14
Dpoke Contrl+2,0
Dpoke Contrl+6,4
Dpoke Intin,In%
Dpoke Intin+2,R%
Dpoke Intin+4,G%
Dpoke Intin+6,B%
Vdisys
Return
'
Comp_crd1:
Data 26,80,26,91,26,102,26,113,26,124
Data 42,80,42,91,42,102,42,113,42,124
Data 57,80,57,91,57,102,57,113,57,124
Data 72,80,72,91,72,102,72,112,72,124
Data 87,80,87,91,87,102,87,113,87,124
'
Comp_crd2:
Data 209,80,209,91,209,102,209,113,209,124
Data 224,80,224,91,224,102,224,113,224,124
Data 239,80,239,91,239,102,239,113,239,124
Data 254,80,254,91,254,102,254,113,254,124
Data 269,80,269,91,269,102,269,113,269,124
'
Cdata:
Data 40,60,84,60,128,60,172,60,216,60
Data 40,89,84,89,128,89,172,89,216,89
Data 40,118,84,118,128,118,172,118,216,118
Data 40,147,84,147,128,147,172,147,216,147
Data 40,176,84,176,128,176,172,176,216,176
'
Small_crds:
Data 23,57,100,128,23,72,100,72,23,83,100,83,23,94,100,94,23,105,100,105,23,116,100,116
Data 39,57,39,128,54,57,54,128,69,57,69,128,84,57,84,128
Data 205,57,282,128,205,72,282,72,205,83,282,83,205,94,282,94,205,105,282,105,205,116,282,116
Data 221,57,221,128,236,57,236,128,251,57,251,128,266,57,266,128
'
Big_crds_lbls:
Data 40,32,"B",85,32,"I",130,32,"N",175,32,"G",220,32,"O"
Data 60,46,"B1",104,46,"I1",148,46,"N1",192,46,"G1",236,46,"O1"
Data 60,74,"B2",104,74,"I2",148,74,"N2",192,74,"G2",236,74,"O2"
Data 60,103,"B3",104,103,"I3",148,103,"N3",192,103,"G3",236,103,"O3"
Data 60,132,"B4",104,132,"I4",148,132,"N4",192,132,"G4",236,132,"O4"
Data 60,161,"B5",104,161,"I5",148,161,"N5",192,161,"G5",236,161,"O5"
'
Mous_crd_dat:
Data 33,72,41,66,1,1,40,60,33,72,41,66,2,1,40,60
Data 76,115,41,66,1,2,84,60,76,115,41,66,2,2,84,60
'
Data 121,159,41,66,1,3,128,60,121,159,41,66,2,3,128,60
Data 163,203,41,66,1,4,172,60,163,203,41,66,2,4,172,60
'
Data 207,244,41,66,1,5,216,60,207,244,41,66,2,5,216,60
Data 33,71,70,94,1,6,40,89,33,71,70,94,2,6,40,89
'
Data 75,113,70,94,1,7,84,89,75,113,70,94,2,7,84,89
Data 119,159,70,94,1,8,128,89,119,159,70,94,2,8,128,89
'
Data 164,202,70,94,1,9,172,89,164,202,70,94,2,9,172,89
Data 208,254,70,94,1,10,216,89,208,254,70,94,2,10,216,89
'
Data 33,70,99,123,1,11,40,118,33,70,99,123,2,11,40,118
Data 77,114,99,123,1,12,84,118,77,114,99,123,2,12,84,118
'
Data 119,158,99,123,1,13,128,118,119,158,99,123,2,13,128,118
Data 163,205,99,123,1,14,172,118,163,205,99,123,2,14,172,118
'
Data 208,244,99,123,1,15,216,118,208,244,99,123,2,15,216,118
Data 33,70,128,153,1,16,40,147,33,70,128,153,2,16,40,147
'
Data 76,114,128,153,1,17,84,147,76,114,128,153,2,17,84,147
Data 119,158,128,153,1,18,128,147,119,158,128,153,2,18,128,147
'
Data 164,203,128,153,1,19,172,147,164,203,128,153,2,19,172,147
Data 208,244,128,153,1,20,216,147,208,244,128,153,2,20,216,147
'
Data 33,70,157,181,1,21,40,176,33,70,157,181,2,21,40,176
Data 75,114,157,181,1,22,84,176,75,114,157,181,2,22,84,176
'
Data 119,157,157,181,1,23,128,176,119,157,157,181,2,23,128,176
Data 163,204,157,181,1,24,172,176,163,204,157,181,2,24,172,176
'
Data 208,244,157,181,1,25,216,176,208,244,157,181,2,25,216,176